#!/usr/bin/env bash
# This script pre-processes the Fortran source code for sunf95.
# 1. It does not recognize overloaded intrinsic functions (particularly, their returning type/kind)
# correctly, e.g., INT in LINALG_MOD.
# 2. It sometimes encounters internal compiler errors when dealing with allocatable characters.
# 3. It does not support `error stop`, which is F2003.

DIR="$(realpath "$1")"
HISTORYF90="history.f90"
HISTORY="$DIR/common/$HISTORYF90"
LINALG90="linalg.f90"
LINALG="$DIR/common/$LINALG90"
LINGEO="$DIR/lincoa/geometry.f90"
LINTR="$DIR/lincoa/trustregion.f90"
LINUPD="$DIR/lincoa/update.f90"
BOBTR="$DIR/bobyqa/trustregion.f90"
CMN_FPRINTF90="fprint.f90"
CMN_FPRINT="$DIR/common/$CMN_FPRINTF90"
MEX_FPRINTF90="fprint.F90"
MEX_FPRINT="$DIR/common/$MEX_FPRINTF90"
DEBUGF90="debug.F90"
DEBUG="$DIR/common/$DEBUGF90"
MEMORYF90="memory.F90"
MEMORY="$DIR/common/$MEMORYF90"
STRINGF90="string.f90"
STRING="$DIR/common/$STRINGF90"
MESSAGEF90="message.f90"
MESSAGE="$DIR/common/$MESSAGEF90"
COBYLB="$DIR/cobyla/cobylb.f90"
CONSTS="$DIR/common/consts.F90"

if ! basename "$DIR" | grep -q ".test\|test." || ! [[ -d "$DIR" ]] ; then
    printf "\n%s is not a testing directory.\n\nExit.\n\n" "$DIR"
    exit 1
fi

sed -i "s/^\s*public :: int\s*$/public :: logical_to_int/" "$LINALG"
sed -i '/^\s*interface int\s*$/,+3d' "$LINALG"
sed -i "s/^\s*use, non_intrinsic :: linalg_mod, only : int\s*$/use, non_intrinsic :: linalg_mod, only : logical_to_int/" "$HISTORY"
sed -i "s/int(output_/logical_to_int(output_/g" "$HISTORY"

if [[ -f "$LINGEO" ]] ; then
    #sed -i "s/\(use, non_intrinsic .*\), trueloc/\1/" "$LINGEO"
    sed -i "s/trueloc(rstat == 1)/:/g" "$LINGEO"
    sed -i "s/trueloc(rstat >= 0)/:/g" "$LINGEO"
fi

if [[ -f "$LINTR" ]] ; then
    sed -i '0,/! Local variables/{s/! Local variables/! Local variables\ninteger(IK), allocatable :: ind(:)/}' "$LINTR"
    sed -i "s|ad(trueloc(resnew > 0)) = matprod(d, amat(:, trueloc(resnew > 0)))|ind = trueloc(resnew > 0)\nad(ind) = matprod(d, amat(:, ind))|" "$LINTR"
    sed -i "s|restmp(trueloc(ad > 0)) = resnew(trueloc(ad > 0)) - matprod(dw, amat(:, trueloc(ad > 0)))|ind = trueloc(ad > 0)\nrestmp(ind) = resnew(ind) - matprod(dw, amat(:, ind))|"  "$LINTR"
    sed -i "s|frac(trueloc(ad > 0)) = restmp(trueloc(ad > 0)) / ad(trueloc(ad > 0))|frac(ind) = restmp(ind) / ad(ind)|"  "$LINTR"
    sed -i "s|ad(trueloc(resnew > 0)) = matprod(d, amat(:, trueloc(resnew > 0)))|ind = trueloc(resnew > 0)\nad(ind) = matprod(d, amat(:, ind))|"  "$LINTR"
    sed -i "s|frac(trueloc(ad > 0)) = restmp(trueloc(ad > 0)) / ad(trueloc(ad > 0))|ind = trueloc(ad > 0)\nfrac(ind) = restmp(ind) / ad(ind)|" "$LINTR"
    sed -i "s|restmp(trueloc(ad > 0)) = resnew(trueloc(ad > 0)) - matprod(psd, amat(:, trueloc(ad > 0)))|ind = trueloc(ad > 0)\nrestmp(ind) = resnew(ind) - matprod(psd, amat(:, ind))|" "$LINTR"
    sed -i "s|ad(trueloc(resnew > 0)) = matprod(dproj, amat(:, trueloc(resnew > 0)))|ind = trueloc(ad > 0)\nad(ind) = matprod(dproj, amat(:, ind))|" "$LINTR"
fi

if [[ -f "$LINUPD" ]] ; then
    sed -i "s/trueloc(mask)/:/g" "$LINUPD"
fi

if [[ -f "$BOBTR" ]] ; then
    sed -i "s|character(len=\*), parameter :: srname = 'TRSBOX'|integer(IK), allocatable :: ind(:)\ncharacter(len=\*), parameter :: srname = 'TRSBOX'|" "$BOBTR"

    TRUELOC="trueloc(xbdi == 0)"
    sed -i "s|ds = inprod(d($TRUELOC), s($TRUELOC))|ind = $TRUELOC\nds = inprod(d(ind), s(ind))|" "$BOBTR"
    sed -i "s|shs = inprod(s($TRUELOC), hs($TRUELOC))|shs = inprod(s(ind), hs(ind))|"  "$BOBTR"

    sed -i "s|d($TRUELOC) = cth * d($TRUELOC) + sth * s($TRUELOC)|ind = $TRUELOC\nd(ind) = cth*d(ind)+ sth*s(ind)|" "$BOBTR"
    sed -i "s|dredg = inprod(d($TRUELOC), gnew($TRUELOC))|dredg = inprod(d(ind), gnew(ind))|" "$BOBTR"

    sed -i "s|gredsq = sum(gnew(trueloc(xbdi == 0))\*\*2)|ind = $TRUELOC\ngredsq = sum(gnew(ind)\*\*2)|" "$BOBTR"
    sed -i "s|shs = inprod(s($TRUELOC), hs($TRUELOC))|ind = $TRUELOC\nshs = inprod(s(ind), hs(ind))|" "$BOBTR"
    sed -i "s|dhs = inprod(d($TRUELOC), hs($TRUELOC))|hs = inprod(d(ind), hs(ind))|" "$BOBTR"
    sed -i "s|dhd = inprod(d($TRUELOC), hdred($TRUELOC))|hs = inprod(d(ind), hdred(ind))|" "$BOBTR"

fi

for FILE in "$CMN_FPRINT" "$MEX_FPRINT" "$DEBUG" ; do
    if [[ -f "$FILE" ]] ; then
        sed -i "s/character(len=:), allocatable/character(len=1024)/" "$FILE"
        sed -i "/character(len=\*), parameter :: newline/d" "$FILE"
        sed -i "s|newline|achar(10)|g" "$FILE"
        sed -i "s|funit_loc = -1|funit_loc = 42|g" "$FILE"
        sed -i "s|newunit|unit|g" "$FILE"
    fi
done

if [[ -f "$STRING" ]] ; then
    sed -i "s/character(len=:), allocatable/character(len=1024)/" "$STRING"
    sed -i "/LEN(S) <= MAX_NUM_STR_LEN/d" "$STRING"
    sed -i "s/write (str, sformat) x/write (*,*) sformat; write (str, *) x/" "$STRING"
    sed -i "/character(len=\*), parameter :: newline/d" "$STRING"
    sed -i "s|newline|achar(10)|g" "$STRING"
fi

if [[ -f "$MEMORY" ]] ; then
    sed -i "s/character(len=:), allocatable/character(len=1024)/" "$MEMORY"
    sed -i "/allocate (character/d" "$MEMORY"
    sed -i "/call validate(allocated(x), 'X is allocated', srname)/d" "$MEMORY"
    sed -i "s/integer :: alloc_status/integer :: alloc_status = 0/" "$MEMORY"
fi

# sunf95 encounters internal errors when handling message.f90.
# In addition, message.f90 does not work due to the changes to string.f90, especially to real2str_vector.
cd "$DIR" && grep -R 'call .*msg' | sed 's|:.*$||' | grep -v 'debug.F90\|fmxapi.F90' | xargs sed -i "s|call .*msg.*$|write(*,*) solver|" && cd - || exit 1
cd "$DIR" && grep -R 'use.*message_mod' | sed 's|:.*$||' | xargs sed -i "/use.*message_mod/d" && cd - || exit 1
printf "module message_mod \n end module message_mod" > "$MESSAGE"

if [[ -f "$DEBUG" ]] ; then
    sed -i "s|^\s*error stop|stop|" "$DEBUG"
fi

# sunf95 is buggy with MAX. It does not ensure MAX(A, B) >= A even with both A and B being finite.
if [[ -f "$COBYLB" ]] ; then
    sed -i -e '/call assert(cpen >= cpen_in/,+3d' "$COBYLB"
fi

# sunf95 does not allow to use sqrt for the initialization of constants.
if [[ -f "$CONSTS" ]] ; then
    sed -i "s|sqrt(EPS)|EPS|g" "$CONSTS"
fi

# sunf95 does not support internal subroutines as arguments.
if [[ -f "$COBYLB" ]] ; then
    sed -ni '1,/\s*!\s*Calculation ends\s*!/p;/end subroutine cobylb/,$p' "$COBYLB"
    sed -i "s|calcfc_internal|calcfc|" "$COBYLB"
fi
for SOL in cobyla uobyqa newuoa bobyqa lincoa ; do
    FILE="$DIR/test_$SOL.f90"
    if [[ -f $FILE ]] ; then
        sed -i "s|subroutine test_solver(\(.*\))\s*$|subroutine test_solver(\1)\n use, non_intrinsic :: recursive_mod, only : recursive_fun1|" "$FILE"
        sed -i "/call $SOL(recursive_fun2/d" "$FILE"
    fi
done

exit 0
